Delphi 2.0 - Programmer's Utilities Power Pack/Delphi 2.0 Programmer's Utilities Power Pack.iso/a_to_d/dwsock11/time.pas

Pascal/Delphi Source File | 1996-09-15 | 5.5 KB | 245 lines

{--------------------------------------------------------------}
{    The main form unit for NETTIME app                           }
{                                                              }
{    By Ulf S÷derberg, [e-mail]                            }
{                                                              }
{    History                                                      }
{        V1.0        950404        US                                       }
{--------------------------------------------------------------}

unit Time;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    Forms, Dialogs, StdCtrls, ExtCtrls, DWinSock, Spin;

type
    TfrmTime = class(TForm)
        sockTime: TClientSocket;
    btnTime: TButton;
        Timer1: TTimer;
    comboHost: TComboBox;
    hdrInfo: THeader;
    gbTime: TGroupBox;
    gbOptions: TGroupBox;
    Label1: TLabel;
    chkDST: TCheckBox;
    spinGMT: TSpinButton;
    Label2: TLabel;
    lblGMT: TLabel;
    clock: TPaintBox;
    Panel1: TPanel;
        procedure btnTimeClick(Sender: TObject);
        procedure sockTimeDisconnect(Sender: TObject);
        procedure sockTimeRead(Sender: TObject);
        procedure sockTimeConnect(Sender: TObject);
        procedure Timer1Timer(Sender: TObject);
        procedure FormCreate(Sender: TObject);
    procedure sockTimeInfo(Sender: TObject; icode: TSockInfo);
    procedure spinGMTDownClick(Sender: TObject);
    procedure spinGMTUpClick(Sender: TObject);
    procedure clockPaint(Sender: TObject);
  private
    { Private declarations }
  public
        { Public declarations }
        elapsedtime    : integer;
        hh, mm, ss    : integer;
    cnt                    : integer;
    thetime            : longint;

    procedure GetTime;
  end;

var
    frmTime: TfrmTime;

implementation

{$R *.DFM}

procedure TfrmTime.btnTimeClick(Sender: TObject);
begin
    Cursor := crHourGlass;
    elapsedtime := 0;
  cnt := 0;
  Timer1.Enabled := true;
    sockTime.Host := comboHost.Text;
    sockTime.Open;
  btnTime.Enabled := false;
end;

procedure TfrmTime.sockTimeDisconnect(Sender: TObject);
begin
    btnTime.Enabled := true;
  hdrInfo.Sections[1] := 'Disconnected';
end;

procedure TfrmTime.sockTimeRead(Sender: TObject);
var
  p        : PChar;
begin
    hdrInfo.Sections[1] := 'Reading time';
  p := @thetime;
  p := p + cnt;
    cnt := cnt + sockTime.RecvBuf(p^, 4 - cnt);
  if cnt = 4 then
        GetTime;
end;

procedure TfrmTime.GetTime;
var
    n        : integer;
    l        : longint;
    tl    : longint;
    tf    : double;
    dt    : TDateTime;
  gmt, c    : integer;
begin
    l := thetime;
    tl := ntohl(l);
    tf := tl and MaxLongInt;
    if tl < 0 then
        begin
            tf := tf + MaxLongInt;
            tf := tf + 1;
        end;
    tl := round(tf - 2208988800.0);
    ss := tl mod 60;
    tl := tl div 60;
    mm := tl mod 60;
    tl := tl div 60;
    if chkDST.Checked then
        tl := tl + 1;
  Val(lblGMT.Caption, gmt, c);
  tl := tl + gmt;
    hh := tl mod 24;
    tl := tl div 24;
    dt := EncodeTime(hh, mm, ss, 0);
    gbTime.Caption := 'Time: ' + TimeToStr(dt);
  sockTime.Close;
    btnTime.Enabled := true;
  hdrInfo.Sections[1] := 'Disconnected';
end;

procedure TfrmTime.sockTimeConnect(Sender: TObject);
begin
    Cursor := crDefault;
  Timer1.Enabled := false;
  cnt := 0;
  hdrInfo.Sections[1] := 'Connected to ' + sockTime.Address;
end;

procedure TfrmTime.Timer1Timer(Sender: TObject);
begin
    inc(elapsedtime);
    if elapsedtime > 20 then
        begin
            Timer1.Enabled := false;
            sockTime.Close;
      MessageDlg('Connect time out', mtInformation, [mbOk], 0);
            btnTime.Enabled := true;
        end;
end;

procedure TfrmTime.FormCreate(Sender: TObject);
begin
    Timer1.Enabled := false;
  elapsedtime := 0;
end;

procedure TfrmTime.sockTimeInfo(Sender: TObject; icode: TSockInfo);
begin
    case icode of
      siLookup : hdrInfo.Sections[1] := 'Looking up host ' + sockTime.Host;
      siConnect :    hdrInfo.Sections[1] := 'Connecting ' + sockTime.Address;
  end;
end;

procedure TfrmTime.spinGMTDownClick(Sender: TObject);
var
    n, c    : integer;
begin
    Val(lblGMT.Caption, n, c);
  dec(n);
    lblGMT.Caption := IntToStr(n);
end;

procedure TfrmTime.spinGMTUpClick(Sender: TObject);
var
    n, c    : integer;
begin
    Val(lblGMT.Caption, n, c);
  inc(n);
    lblGMT.Caption := IntToStr(n);
end;

procedure TfrmTime.clockPaint(Sender: TObject);
var
    cx, cy        : real;
  x,    y            : integer;
  r                    : real;
  a                    : integer;

  procedure Polar(radius : real);
  var
      v    : integer;
  begin
      v := a - 15;
      x := round(cx + radius * cos(6 * v * pi / 180));
    y := round(cx + radius * sin(6 * v * pi / 180));
  end;

begin
     with TPaintBox(Sender) do
      begin
        cx := Width / 2;
      cy := Height / 2;
      r := cx;
      for a := 0 to 59 do
          begin
                    Polar(r);
          Canvas.MoveTo(x, y);
          if (a mod 5) = 0 then
              begin
                Canvas.Pen.Color := clBlack;
                  Polar(r - 5);
            end
          else
              begin
                Canvas.Pen.Color := clBlue;
                  Polar(r - 3);
            end;
          Canvas.LineTo(x, y);
        end;

      { Hours }
          Canvas.Pen.Color := clRed;
          a := ((hh * 60) + mm) div 12;
          r := cx * 60 / 100;
          Polar(r);
            Canvas.MoveTo(round(cx), round(cy));
            Canvas.LineTo(x, y);

      { Minutes }
          a := mm;
          r := cx * 85 / 100;
          Polar(r);
            Canvas.MoveTo(round(cx), round(cy));
            Canvas.LineTo(x, y);

      { Seconds }
          Canvas.Pen.Color := clWhite;
          a := ss;
          r := cx * 90 / 100;
          Polar(r);
            Canvas.MoveTo(round(cx), round(cy));
            Canvas.LineTo(x, y);

      end;
end;

end.